Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/buttons/toolb160/sample/mdimain.frm

Text File | 1995-02-12 | 17KB | 554 lines

VERSION 2.00
Begin MDIForm frmMain
   Caption         =   "ToolBarPad"
   ClientHeight    =   5040
   ClientLeft      =   855
   ClientTop       =   1785
   ClientWidth     =   7740
   Height          =   5730
   Left            =   795
   LinkTopic       =   "ToolBarPad"
   Tag             =   "Select the entire text of the active file"
   Top             =   1155
   Width           =   7860
   Begin StatusBar StatusBar1
      AdjustFieldHeight=   0   'False
      Align           =   2  'Align Bottom
      AutoToggle      =   -1  'True
      CapsLockOffText =   ""
      CapsLockOnText  =   "CAPS"
      ExpandField     =   0
      FieldProperties =   MDIMAIN.FRX:0000
      FloodColor      =   &H00FF0000&
      FloodField      =   -1
      FloodInvertText =   0   'False
      FloodPercent    =   0
      FloodShowPct    =   -1  'True
      Font3D          =   0  'none
      Height          =   375
      Left            =   0
      LeftMargin      =   3
      MenuTagsField   =   0
      NumLockOffText  =   ""
      NumLockOnText   =   "NUM"
      RightMargin     =   3
      ScrollLockOffText=   ""
      ScrollLockOnText=   "SCRL"
      Top             =   4665
      Width           =   7740
      Begin CommonDialog cmDialog
         Left            =   660
         Top             =   120
      End
      Begin Label lblAction
         BackStyle       =   0  'Transparent
         Height          =   135
         Left            =   2280
         TabIndex        =   4
         Top             =   120
         Visible         =   0   'False
         Width           =   615
      End
   End
   Begin ButtonBar ButtonBar1
      Align           =   1  'Align Top
      ButtonColumns   =   4
      ButtonPictures  =   MDIMAIN.FRX:05DD
      ButtonProperties=   MDIMAIN.FRX:F5A7
      ButtonRows      =   29
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   435
      HintBackColor   =   &H0080FFFF&
      HintDelay       =   1000
      HintOffsetX     =   4
      HintOffsetY     =   4
      HintPosition    =   3  'Below Left
      hWndStatusBar   =   MDIMAIN.FRX:20E60
      IgnoreInvisibleButtons=   0   'False
      Left            =   0
      LeftMargin      =   3
      OutlineChildren =   2  'Inset
      ShowDisabledHints=   -1  'True
      ShowDisabledMessages=   -1  'True
      ShowHints       =   -1  'True
      ShowStatusMessage=   4  'Together with Hint
      StatusField     =   0
      Top             =   0
      Width           =   7740
      Begin ComboBox cboFontNames
         Height          =   300
         Left            =   5400
         Sorted          =   -1  'True
         Style           =   2  'Dropdown List
         TabIndex        =   1
         Top             =   60
         Width           =   1935
      End
      Begin ComboBox cboFontSizes
         Height          =   300
         Left            =   7920
         Style           =   2  'Dropdown List
         TabIndex        =   0
         Top             =   60
         Width           =   855
      End
      Begin Label Label1
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "Fontname:"
         Height          =   195
         Left            =   4440
         TabIndex        =   3
         Top             =   120
         Width           =   900
      End
      Begin Label Label2
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "Size:"
         Height          =   195
         Left            =   7440
         TabIndex        =   2
         Top             =   120
         Width           =   435
      End
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Tag             =   "File operations and exit ToolBarPad"
      Begin Menu mnuFileNew
         Caption         =   "&New"
         Shortcut        =   ^N
         Tag             =   "Create a new file"
      End
      Begin Menu mnuFileOpen
         Caption         =   "&Open..."
         Shortcut        =   ^O
         Tag             =   "Open an existing file"
      End
      Begin Menu mnuFileSave
         Caption         =   "&Save..."
         Shortcut        =   ^S
         Tag             =   "Save the active file"
      End
      Begin Menu mnuFileSaveAs
         Caption         =   "Save &As..."
         Shortcut        =   ^A
         Tag             =   "Save the active file under a new name"
      End
      Begin Menu mnuFileSep1
         Caption         =   "-"
      End
      Begin Menu mnuFilePrint
         Caption         =   "&Print"
         Shortcut        =   ^P
         Tag             =   "Print the active file"
      End
      Begin Menu mnuFilePrintSetup
         Caption         =   "Print Se&tup..."
         Tag             =   "Set printer options"
      End
      Begin Menu mnuFileSep2
         Caption         =   "-"
      End
      Begin Menu mnuFileExit
         Caption         =   "E&xit"
         Tag             =   "Exit ToolBarPad"
      End
   End
   Begin Menu mnuEdit
      Caption         =   "&Edit"
      Tag             =   "Edit operations"
      Begin Menu mnuEditUndo
         Caption         =   "&Undo"
         Shortcut        =   ^Z
         Tag             =   "Undo the previous edit action"
      End
      Begin Menu mnuEditSep1
         Caption         =   "-"
      End
      Begin Menu mnuEditCut
         Caption         =   "Cu&t"
         Shortcut        =   ^X
         Tag             =   "Move the selected text to the clipboard"
      End
      Begin Menu mnuEditCopy
         Caption         =   "&Copy"
         Shortcut        =   ^C
         Tag             =   "Copy the selected text to the Clipboard"
      End
      Begin Menu mnuEditPaste
         Caption         =   "&Paste"
         Shortcut        =   ^V
         Tag             =   "Paste the Clipboard text at the insertion point"
      End
      Begin Menu mnuEditDelete
         Caption         =   "&Delete"
         Shortcut        =   {DEL}
         Tag             =   "Delete the selected text or the character at the insertion point"
      End
      Begin Menu mnuEditSep2
         Caption         =   "-"
      End
      Begin Menu mnuEditSelectAll
         Caption         =   "&Select All"
         Tag             =   "Select the entire text of the active file"
      End
      Begin Menu mnuEditDateTime
         Caption         =   "&Date/Time"
         Shortcut        =   {F5}
         Tag             =   "Insert the current date and time"
      End
   End
   Begin Menu mnuFind
      Caption         =   "&Find"
      Tag             =   "Find operations"
      Begin Menu mnuFindFind
         Caption         =   "&Find..."
         Tag             =   "Find a text pattern"
      End
      Begin Menu mnuFindFindNext
         Caption         =   "Find &Next"
         Shortcut        =   {F3}
         Tag             =   "Repeat the search"
      End
      Begin Menu mnuFintReplace
         Caption         =   "&Replace..."
         Shortcut        =   ^R
         Tag             =   "Find a text pattern and replace it with other text"
      End
   End
   Begin Menu mnuWindow
      Caption         =   "&Window"
      Tag             =   "Window operations"
      WindowList      =   -1  'True
      Begin Menu mnuWindowCascade
         Caption         =   "&Cascade"
         Shortcut        =   +{F5}
         Tag             =   "Arrange the windows in a cascaded view"
      End
      Begin Menu mnuWindowTile
         Caption         =   "&Tile"
         Shortcut        =   +{F4}
         Tag             =   "Arrange the windows in a tiled view"
      End
      Begin Menu mnuWindowArrangeIcons
         Caption         =   "&Arrange Icons"
         Tag             =   "Arrange all iconized windows"
      End
   End
End
Option Explicit

Sub ButtonBar1_Click (Button As Integer, Group As Integer, State As Integer)
    Select Case Button
    Case 0: mnuFileNew_Click
    Case 1: mnuFileOpen_Click
    Case 2: mnuFileSave_Click
    Case 3: mnuEditCut_Click
    Case 4: mnuEditCopy_Click
    Case 5: mnuEditPaste_Click
    Case 6: mnuFilePrint_Click
    Case 7:
        If Not frmMain.ActiveForm Is Nothing Then
        frmMain.ActiveForm!txtDocument.FontBold = State
        End If
    Case 8:
        If Not frmMain.ActiveForm Is Nothing Then
        frmMain.ActiveForm!txtDocument.FontItalic = State
        End If
    Case 9:
        If Not frmMain.ActiveForm Is Nothing Then
        frmMain.ActiveForm!txtDocument.FontUnderLine = State
        End If
    Case 10: MsgBox "Help not implemented yet"
    End Select
End Sub

Sub cboFontNames_Click ()
    If frmMain.ActiveForm Is Nothing Then Exit Sub
    frmMain.ActiveForm!txtDocument.FontName = cboFontNames.List(cboFontNames.ListIndex)
End Sub

Sub cboFontSizes_Click ()
    If frmMain.ActiveForm Is Nothing Then Exit Sub
    frmMain.ActiveForm!txtDocument.FontSize = Val(cboFontSizes.List(cboFontSizes.ListIndex))
End Sub

Sub lblAction_Change ()
    If lblAction.Caption = "" Then Exit Sub
    mnuFileSave_Click
    lblAction.Caption = ""
End Sub

Sub MDIForm_Load ()
Dim I As Integer
    Screen.MousePointer = 11

    WindowState = 2

    ButtonBar1.ControlHwnd = cboFontNames.hWnd
    ButtonBar1.ControlHint = "Select font"
    ButtonBar1.ControlMessage = "Select the font for the current and new documents"
    ButtonBar1.ControlHwnd = cboFontSizes.hWnd
    ButtonBar1.ControlHint = "Select fontsize"
    ButtonBar1.ControlMessage = "Select the fontsize for the current and new documents"

    ButtonBar1.hWndStatusBar = StatusBar1.hWnd
    ButtonBar1.StatusField = 0

    For I = 0 To Screen.FontCount - 1
    cboFontNames.AddItem Screen.Fonts(I)
    If Screen.Fonts(I) = ButtonBar1.FontName Then
        cboFontNames.ListIndex = cboFontNames.NewIndex
    End If
    Next I
    For I = 6 To 40 Step 2
    cboFontSizes.AddItem Format$(I)
    Next I
    cboFontSizes.ListIndex = 2

    CheckEditMenu

    Screen.MousePointer = 0
End Sub

Sub MDIForm_Unload (Cancel As Integer)
    gbMainActive = False
    End
End Sub

Sub mnuEditCopy_Click ()
    If frmMain.ActiveForm Is Nothing Then Exit Sub
    ClipBoard.SetText frmMain.ActiveForm!txtDocument.SelText
    CheckEditMenu
End Sub

Sub mnuEditCut_Click ()
    If frmMain.ActiveForm Is Nothing Then Exit Sub
    ClipBoard.SetText frmMain.ActiveForm!txtDocument.SelText
    frmMain.ActiveForm!txtDocument.SelText = ""
    CheckEditMenu
End Sub

Sub mnuEditDateTime_Click ()
    If frmMain.ActiveForm Is Nothing Then Exit Sub
    frmMain.ActiveForm!txtDocument.SelText = Format$(Now, "mm/dd/yy, hh:mm:ss")
End Sub

Sub mnuEditDelete_Click ()
    If frmMain.ActiveForm Is Nothing Then Exit Sub
    frmMain.ActiveForm!txtDocument.SelText = ""
    CheckEditMenu
End Sub

Sub mnuEditPaste_Click ()
    If frmMain.ActiveForm Is Nothing Then Exit Sub
    frmMain.ActiveForm!txtDocument.SelText = ClipBoard.GetText()
    CheckEditMenu
End Sub

Sub mnuEditSelectAll_Click ()
    If frmMain.ActiveForm Is Nothing Then Exit Sub
    frmMain.ActiveForm!txtDocument.SelStart = 0
    frmMain.ActiveForm!txtDocument.SelLength = Len(frmMain.ActiveForm!txtDocument.Text)
    CheckEditMenu
End Sub

Sub mnuEditUndo_Click ()
Dim lRes As Long
    If frmMain.ActiveForm Is Nothing Then Exit Sub
    lRes = SendMessage(frmMain.ActiveForm!txtDocument.hWnd, EM_UNDO, 0, 0)
    CheckEditMenu
End Sub

Sub mnuFileExit_Click ()
    If MsgBox("Are you sure you want to quit?", 36) = 6 Then
    Unload Me
    End If
End Sub

Sub mnuFileNew_Click ()
Dim frmDoc As New frmDocument
    frmDoc.Caption = "Untitled"
    frmDoc!txtDocument.Text = ""
    frmDoc!txtDocument.FontName = cboFontNames.List(cboFontNames.ListIndex)
    frmDoc!txtDocument.FontSize = Val(cboFontSizes.List(cboFontSizes.ListIndex))
    frmDoc!txtDocument.FontBold = ButtonBar1.ButtonState(7)
    frmDoc!txtDocument.FontItalic = ButtonBar1.ButtonState(8)
    frmDoc!txtDocument.FontUnderline = ButtonBar1.ButtonState(9)
    frmDoc!lblAction.Caption = "set changed = false"
    frmDoc!lblAction.Caption = "set findposition = 0"
    frmDoc.Show
End Sub

Sub mnuFileOpen_Click ()
Dim frmDoc As frmDocument
Dim iFree As Integer
Dim sText As String
    cmDialog.Flags = 0
    cmDialog.Filter = "Text files (*.txt)|*.txt|All files (*.*)|*.*"
    cmDialog.FilterIndex = 1
    cmDialog.CancelError = True
    On Local Error Resume Next
    cmDialog.Action = 1
    If Err = 0 Then
    iFree = FreeFile
    Open cmDialog.Filename For Input As #iFree
    If Err Then
        MsgBox "Error opening " + cmDialog.Filename, 64
        Exit Sub
    End If
    If LOF(iFree) > 32000 Then
        MsgBox "File too large to edit", 64
        Close #iFree
        Exit Sub
    End If
    sText = Input$(LOF(iFree), iFree)
    Close #iFree
    If Err Then
        MsgBox "Error reading file", 64
        Exit Sub
    End If
    Set frmDoc = New frmDocument
    frmDoc.Caption = cmDialog.Filename
    frmDoc!txtDocument.FontName = cboFontNames.List(cboFontNames.ListIndex)
    frmDoc!txtDocument.FontSize = Val(cboFontSizes.List(cboFontSizes.ListIndex))
    frmDoc!txtDocument.FontBold = ButtonBar1.ButtonState(7)
    frmDoc!txtDocument.FontItalic = ButtonBar1.ButtonState(8)
    frmDoc!txtDocument.FontUnderline = ButtonBar1.ButtonState(9)
    frmDoc!txtDocument.Text = sText
    frmDoc!lblAction.Caption = "set changed = false"
    frmDoc!lblAction.Caption = "set findposition = 0"
    End If
End Sub

Sub mnuFilePrint_Click ()
    If frmMain.ActiveForm Is Nothing Then Exit Sub
    On Local Error Resume Next
    Printer.Print frmMain.ActiveForm.txtDocument.Text
    Printer.EndDoc
    If Err Then
    MsgBox "Error during print", 64
    End If
End Sub

Sub mnuFilePrintSetup_Click ()
    cmDialog.Flags = &H40
    On Local Error Resume Next
    cmDialog.Action = 5
End Sub

Sub mnuFileSave_Click ()
    If frmMain.ActiveForm Is Nothing Then Exit Sub
    If frmMain.ActiveForm.Caption = "Untitled" Then
    mnuFileSaveAs_Click
    Else
    SaveFile frmMain.ActiveForm.Caption, True
    End If
End Sub

Sub mnuFileSaveAs_Click ()
    If frmMain.ActiveForm Is Nothing Then Exit Sub
    cmDialog.Flags = &H800 + &H2
    cmDialog.Filter = "Text files (*.txt)|*.txt|All files (*.*)|*.*"
    cmDialog.FilterIndex = 1
    If frmMain.ActiveForm.Caption <> "Untitled" Then cmDialog.Filename = frmMain.ActiveForm.Caption
    On Local Error Resume Next
    cmDialog.Action = 2
    If Err = 0 Then SaveFile cmDialog.Filename, False
End Sub

Sub mnuFindFind_Click ()
    frmFind.Show
End Sub

Sub mnuFindFindNext_Click ()
    FindText
End Sub

Sub mnuFintReplace_Click ()
    MsgBox "Replace command not implemented in this demo"
End Sub

Sub mnuWindowArrangeIcons_Click ()
    frmMain.Arrange 3
End Sub

Sub mnuWindowCascade_Click ()
    frmMain.Arrange 0
End Sub

Sub mnuWindowTile_Click ()
    frmMain.Arrange 1
End Sub

Sub SaveFile (ByVal sFile As String, bAskOverwrite As Integer)
Dim iFree As Integer
    On Local Error Resume Next
    Screen.MousePointer = 11

    If bAskOverwrite Then
    iFree = FreeFile
    Open sFile For Input As #iFree
    If Err = 0 Then
        Close iFree
        Screen.MousePointer = 0
        If MsgBox(sFile + Chr$(13) + Chr$(10) + "File Exists. Overwrite?", 52) <> 6 Then
        cmDialog.Flags = &H800 + &H2
        cmDialog.Filter = "Text files (*.txt)|*.txt|All files (*.*)|*.*"
        cmDialog.FilterIndex = 1
        cmDialog.Filename = sFile
        On Local Error Resume Next
        cmDialog.Action = 2
        If Err <> 0 Then
            Exit Sub
        Else
            sFile = cmDialog.Filename
        End If
        End If
    End If
    End If

    Screen.MousePointer = 11

    iFree = FreeFile
    Open sFile For Output As #iFree
    If Err Then
    Screen.MousePointer = 0
    MsgBox "Error opening file", 64
    Exit Sub
    End If
    Print #iFree, frmMain.ActiveForm!txtDocument.Text
    Close #iFree
    Screen.MousePointer = 0
    If Err Then
    MsgBox "Error writing to file", 64
    Else
    If gcForm Is Nothing Then
        frmMain.ActiveForm!lblAction.Caption = "set changed = false"
    Else
        gcForm!lblAction.Caption = "set changed = false"
    End If
    End If
End Sub

Sub StatusBar1_SysMenuBrowse (MenuID As Integer, Message As String)
    Select Case MenuID
    Case Is > 0: Message = "Quit, resize or move this application"
    Case -4096: Message = "Changes the window size"
    Case -4080: Message = "Changes the window position"
    Case -4064: Message = "Reduces the window to an icon"
    Case -4048: Message = "Enlarges the window to full size"
    Case -4000: Message = "Quits ToolBarPad and prompts to save altered files"
    Case -3808: Message = "Restores the window to normal size"
    Case -3792: Message = "Switches to another task"
    End Select
End Sub